home *** CD-ROM | disk | FTP | other *** search
/ PC Pro 2005 June (DVD) / DPPRO0605DVD.iso / Install / program files / Borland / BDS / 3.0 / Demos / Delphi.Net / VCL / Shape / Shapes.pas < prev   
Encoding:
Pascal/Delphi Source File  |  2004-10-22  |  2.3 KB  |  122 lines
  1. unit Shapes;
  2.  
  3. interface
  4.  
  5. uses
  6.   Classes, ExtCtrls, StdCtrls, Forms, SysUtils;
  7.  
  8.  
  9.  
  10. type
  11.   TForm1 = class(TForm)
  12.     ColorBox1: TColorBox;
  13.     Label1: TLabel;
  14.     Shape1: TShape;
  15.     RadioGroup1: TRadioGroup;
  16.   private
  17.     { Private declarations }
  18.         procedure InitializeControls;
  19.   public
  20.     { Public declarations }
  21.         constructor Create(AOwner: TComponent); override;
  22.     procedure UpdateShape(Sender: TObject);
  23.   end;
  24.  
  25. var
  26.   Form1: TForm1;
  27.  
  28. implementation
  29.  
  30. uses
  31.   Graphics, Windows;
  32.  
  33.  
  34. constructor TForm1.Create(AOwner: TComponent);
  35. begin
  36.   inherited CreateNew(AOwner);
  37.     InitializeControls;
  38. end;
  39.  
  40. procedure TForm1.InitializeControls;
  41. begin
  42.   // Initalizing all controls...
  43.   ColorBox1 := TColorBox.Create(Form1);
  44.     Label1 := TLabel.Create(Form1);
  45.     Shape1 := TShape.Create(Form1);
  46.     RadioGroup1 := TRadioGroup.Create(Form1);
  47.  
  48.     // Form's PMEs'
  49.     Caption:= 'Shape Changer';
  50.     Color:= clBtnFace;
  51.     Font.Charset:= DEFAULT_CHARSET;
  52.     Font.Color:= clWindowText;
  53.     Font.Height:= -11;
  54.     Font.Name:= 'MS Sans Serif';
  55.     Font.Style:= [];
  56.     PixelsPerInch:= 96;
  57.  
  58.   with ColorBox1 do
  59.   begin
  60.     Parent := Self;
  61.     Left := 175;
  62.     Top := 150;
  63.     OnSelect := UpdateShape;
  64.   end;
  65.  
  66.     with Label1 do
  67.     begin
  68.         Parent:= Self;
  69.         Left:= 20;
  70.         Top:= 20;
  71.     Caption := 'Rectangle';
  72.     end;
  73.  
  74.     with Shape1 do
  75.     begin
  76.         Parent:= Self;
  77.         Left:= 20;
  78.         Top:= 60;
  79.     Width := 150;
  80.         Shape := stRectangle;
  81.     Brush.Color := clBlack;
  82.     end;
  83.  
  84.     with RadioGroup1 do
  85.     begin
  86.         Parent:= Self;
  87.         Left:= 175;
  88.         Top:= 20;
  89.     Items.Add('Rectangle');
  90.     Items.Add('Square');
  91.     Items.Add('RoundRect');
  92.     Items.Add('RoundSquare');
  93.     Items.Add('Ellipse');
  94.     Items.Add('Circle');
  95.     ItemIndex := 0;
  96.     OnClick := UpdateShape;
  97.     end;
  98. end;
  99.  
  100. procedure TForm1.UpdateShape(Sender: TObject);
  101. var
  102.   S: string;
  103. begin
  104.   S := RadioGroup1.Items[RadioGroup1.ItemIndex];
  105.   Label1.Caption := S;
  106.   Shape1.Brush.Color := ColorBox1.Selected;
  107.   if SameText(S, 'Rectangle') then
  108.     Shape1.Shape := stRectangle
  109.   else if SameText(S, 'Square') then
  110.     Shape1.Shape := stSquare
  111.   else if SameText(S, 'RoundRect') then
  112.     Shape1.Shape := stRoundRect
  113.   else if SameText(S, 'RoundSquare') then
  114.     Shape1.Shape := stRoundSquare
  115.   else if SameText(S, 'Ellipse') then
  116.     Shape1.Shape := stEllipse
  117.   else
  118.     Shape1.Shape := stCircle;
  119. end;
  120.  
  121. end.
  122.